home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_Tix.idb / usr / freeware / lib / tix4.1 / DialogS.tcl.z / DialogS.tcl
Encoding:
Text File  |  1999-01-26  |  4.0 KB  |  170 lines
  1. # DialogS.tcl --
  2. #
  3. #
  4. #    Implements the DialogShell widget. It tells the window
  5. #    manager that it is a dialog window and should be treated specially.
  6. #    The exact treatment depends on the treatment of the window
  7. #    manager
  8. #
  9. # Copyright (c) 1994-1996, Expert Interface Technologies
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13. #
  14.  
  15. tixWidgetClass tixDialogShell {
  16.     -superclass tixShell
  17.     -classname  TixDialogShell
  18.     -method {
  19.     popdown popup center
  20.     }
  21.     -flag   {
  22.     -mapped -minheight -minwidth -parent -transient
  23.     }
  24.     -static {}
  25.     -configspec {
  26.     {-mapped mapped Mapped 0}
  27.     {-minwidth minWidth MinWidth 0}
  28.     {-minheight minHeight MinHeight 0}
  29.     {-transient transient Transient true}
  30.     {-parent parent Parent ""}
  31.     }
  32. }
  33.  
  34. #----------------------------------------------------------------------
  35. #        Construct widget
  36. #----------------------------------------------------------------------
  37.  
  38. proc tixDialogShell:ConstructWidget {w} {
  39.     upvar #0 $w data
  40.  
  41.     tixChainMethod $w ConstructWidget
  42.  
  43.     # Set the title of this shell appropriately
  44.     #
  45.     if {$data(-title) == ""} {
  46.     # dynamically sets the title
  47.     #
  48.     set data(-title) [winfo name $w]
  49.     }
  50.     wm title $w $data(-title)
  51.  
  52.     # Set the parent of this dialog shell
  53.     #
  54.     if {$data(-parent) == ""} {
  55.     set data(-parent) [winfo parent $w]
  56.     }
  57.  
  58.     # Set the minsize and maxsize of the thing
  59.     #
  60.     wm minsize $w $data(-minwidth) $data(-minheight)
  61. }
  62.  
  63. # The next procedures manage the dialog boxes
  64. #
  65. proc tixDialogShell:popup {w {parent ""}} {
  66.     upvar #0 $w data
  67.  
  68.     # First update to make sure the boxes are the right size
  69.     #
  70.     update idletask
  71.  
  72.     # Then we set the position and update
  73.     #
  74.     tixDialogShell:center $w $parent
  75.  
  76.     # and now make it visible. Viola!  Centered over parent.
  77.     #
  78.     wm deiconify $w
  79. }
  80.  
  81. # This procedure centers a dialog box over a window making sure that the 
  82. # dialog box doesn't appear off the screen
  83. #
  84. # However, if the parent is smaller than this dialog, make this dialog
  85. # appear at parent(x,y) + (20,20)
  86. #
  87. proc tixDialogShell:center {w {parent ""}} {
  88.     upvar #0 $w data
  89.  
  90.     # Tell the WM that we'll do this ourselves.
  91.     wm sizefrom $w user
  92.     wm positionfrom $w user
  93.  
  94.     if {$parent == ""} {
  95.     set parent $data(-parent)
  96.     }
  97.     if [catch {set parent [winfo toplevel $parent]}] {
  98.     set parent "."
  99.     }
  100.  
  101.     # Where is my parent and what are it's dimensions
  102.     #
  103.     if {$parent != ""} {
  104.     set pargeo [split [wm geometry $parent] "+x"]
  105.     set parentW [lindex $pargeo 0]
  106.     set parentH [lindex $pargeo 1]
  107.     set parx [lindex $pargeo 2]
  108.     set pary [lindex $pargeo 3]
  109.  
  110.     if {[tixGetBoolean -nocomplain $data(-transient)]} {
  111.         wm transient $w $parent
  112.     }
  113.     } else {
  114.     set parentW [winfo screenwidth $w]
  115.     set parentH [winfo screenheight $w]
  116.     set parx 0
  117.     set pary 0
  118.     set parent [winfo parent $w]
  119.     }
  120.  
  121.     # What are is the offset of the virtual window
  122.     set vrootx [winfo vrootx $parent]
  123.     set vrooty [winfo vrooty $parent]
  124.  
  125.     # What are my dimensions ?
  126.     set dialogW [winfo reqwidth $w]
  127.     set dialogH [winfo reqheight $w]
  128.  
  129.     if {$dialogW < [expr $parentW-30] || $dialogW < [expr $parentH-30]} {
  130.     set dialogx [expr $parx+($parentW-$dialogW)/2+$vrootx]
  131.     set dialogy [expr $pary+($parentH-$dialogH)/2+$vrooty]
  132.     } else {
  133.     # This dialog is too big. Place it at (parentx, parenty) + (20,20)
  134.     #
  135.     set dialogx [expr $parx+20+$vrootx]
  136.     set dialogy [expr $pary+20+$vrooty]
  137.     }
  138.  
  139.     set maxx [expr "[winfo screenwidth  $parent] - $dialogW"]
  140.     set maxy [expr "[winfo screenheight $parent] - $dialogH"]
  141.  
  142.     # Make sure it doesn't go off screen
  143.     #
  144.     if {$dialogx < 0} {
  145.     set dialogx 0
  146.     } else {
  147.     if {$dialogx > $maxx} {
  148.         set dialogx $maxx
  149.     }
  150.     }
  151.     if {$dialogy < 0} {
  152.     set dialogy 0
  153.     } else {
  154.     if {$dialogy > $maxy} {
  155.         set dialogy $maxy
  156.     }
  157.     }
  158.  
  159.     # set my new position (and dimensions)
  160.     #
  161.     if {[wm geometry $w] == "1x1+0+0"} {
  162.     wm geometry $w $dialogW\x$dialogH\+$dialogx\+$dialogy
  163.     }
  164. }
  165.  
  166. proc tixDialogShell:popdown {w args} {
  167.     wm withdraw $w
  168. }
  169.  
  170.